Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/cpkocx17/briscola.bas

BASIC Source File | 1998-07-17 | 36.2 KB | 1,460 lines

Attribute VB_Name = "Briscola"
Option Explicit

'
' Application Program Information and related constants
'
Global Const App_Version$ = "Version 1.6, 10 July 1998"
Global Const App_Copyright$ = "Copyright ⌐ 1996-1998 Andy Zanna"
Global Const App_Author$ = "Written by A.Zanna"

Global Const SEC_GLOBAL = "Briscola"
Global Const KEY_WORKDIR = "WorkDir"

Global Const App_DDEShare = "Briscola$"
Global Const App_FileType = "Briscola Game"
Global Const App_FileExt = "bri"
Global Const App_ClipFormat = 1             ' Text. We could check for more than one format...

Global Const App_Profile = "Briscola.INI"

Global App_Debug

Global Game_OtherPC As String               ' name of other workstation
Global Game_OtherPlayer As String           ' name of other guy

Global Game_InProgress As Integer           ' Flag a game is in progress
Global Game_FileName$                       ' Current file name
Global Game_Mode As Integer                 ' normal network or demo

Global Game_BriscolaSuit  As Integer

Global Hand_Number As Integer               ' # of hand being played
Global Hand_Winner As Integer               ' winner of this hand (<> 0 flags Hand_Next() needs running)
Global Hand_CardPlayer1  As Integer         ' cards played by player 1 and 2
Global Hand_CardPlayer2  As Integer
Global Hand_PlayerTurn  As Integer          ' # of player who's to deal or play

Global Player1_Score  As Integer            ' score for player 1
Global Player1_AutoPlay As Integer          ' autoplay enabled for player 1
Global Player1_Name As String               ' cached player Name

Global Player2_AutoPlay As Integer          ' autoplay enabled for player 2
Global Player2_Score  As Integer            ' score for player 2
Global Player2_Name As String               ' cached player Name

Global Const Game_NoFileName$ = "Unnamed"   ' Used when no file active

Global Const MUST_PLAY = "'s turn"
Global Const WINS_HAND = " wins hand"
Global Const WINS_GAME = " wins game! "
Global Const GAME_IS_DRAW = "Game is a draw"
Global Const NOT_YOUR_TURN = ", it's not your turn!"
Global Const NOT_YOUR_CARDS = ", those are not your cards!"
Global Const NOT_NOW = ", you can't do that just now"

Global Const MSG_MODE_NORMAL = "Mode: Normal"
Global Const MSG_MODE_NETWORK = "Mode: Network"
Global Const MSG_MODE_DEMO = "Mode: Demo"

Global Const MODE_NORMAL = 1
Global Const MODE_NETWORK = 2
Global Const MODE_DEMO = 3



'
' In network mode, only 1 player (the last deals or stashes cards),
' the other party will receive cards via DDE. This prevents
' conflicting updates via cross DDE
'
Function Game_IsDealer() As Integer

    Game_IsDealer = True

    If Game_Mode = MODE_NETWORK And Hand_PlayerTurn <> 1 Then
        Game_IsDealer = False
    End If

    If App_Debug Then
        If Game_IsDealer Then
            Trace "Game_IsDealer: yes"
        Else
            Trace "Game_IsDealer: no, waiting for network peer"
        End If
    End If

End Function

Sub Game_Open(fname As String)
    If App_Debug Then Trace "Game_Open"

#If Win16 Then
    Game_OpenAsBin fname
#Else
    Game_OpenAsText fname
#End If

    Game_FileName$ = fname
    Form_SetTitle Game
    Game_ShowScore
    Game_Pause True
    Game_InProgress = True
    Game.Player2Name = Player2_Name
    Game.Player1Name = Player1_Name

    ' we will never restore network connection
    ' so default to let computer handle player 2
    Player2_AutoPlay = True

    ' saved in demo mode?
    If Player1_AutoPlay Then
        Game.OptPeek.Checked = 1
        Game.Player2.StackFacing = CARDS_FACING_UP
    End If

End Sub

Sub Game_OpenAsText(fname As String)
    Dim s$

    If App_Debug Then Trace "Game_OpenAsText"
    On Error GoTo open_error

    Open fname For Input As #1

    On Error GoTo open_done

    Input #1, Hand_Number
    Input #1, Hand_CardPlayer1
    Input #1, Hand_CardPlayer2
    Input #1, Hand_PlayerTurn
    Input #1, Hand_Winner
    Input #1, Game_BriscolaSuit

    Input #1, Player1_Score
    Input #1, Player1_AutoPlay
    Input #1, Player1_Name

    Input #1, Player2_AutoPlay
    Input #1, Player2_Score
    Input #1, Player2_Name

    Input #1, s$
    Game.Player1 = s$
    Input #1, s$
    Game.Player2 = s$
    Input #1, s$
    Game.Stack1 = s$
    Input #1, s$
    Game.Stack2 = s$
    Input #1, s$
    Game.Briscola = s$
    Input #1, s$
    Game.OnTable = s$
    Input #1, s$
    Game.Deck = s$

open_done:

    Close #1
    Exit Sub

open_error:
    ReportError "Can't open File" & Chr$(10) & "'" & fname & "'"
    Exit Sub

End Sub

Sub Game_Save(fname As String)
    If App_Debug Then Trace "Game_Save"

#If Win16 Then
    Game_SaveAsBin fname
#Else
    Game_SaveAsText fname
#End If

    Game_FileName = fname
    Form_SetTitle Game

End Sub

Sub Game_SaveAsText(fname As String)

    Dim s$
    If App_Debug Then Trace "Game_SaveAsText"
    On Error GoTo save_error

    Open fname For Output As #1

    On Error GoTo write_error

    Print #1, Hand_Number
    Print #1, Hand_CardPlayer1
    Print #1, Hand_CardPlayer2
    Print #1, Hand_PlayerTurn
    Print #1, Hand_Winner

    Print #1, Game_BriscolaSuit

    Print #1, Player1_Score
    Print #1, Player1_AutoPlay
    Print #1, Player1_Name

    Print #1, Player2_AutoPlay
    Print #1, Player2_Score
    Print #1, Player2_Name

    s$ = Game.Player1
    Print #1, s$
    s$ = Game.Player2
    Print #1, s$
    s$ = Game.Stack1
    Print #1, s$
    s$ = Game.Stack2
    Print #1, s$
    s$ = Game.Briscola
    Print #1, s$
    s$ = Game.OnTable
    Print #1, s$
    s$ = Game.Deck
    Print #1, s$

write_error:
    Close #1


save_error:
    Exit Sub

End Sub

'
' Report whether a player is allowed to play
'
Function Hand_CanPlay(pl%) As Integer

    Hand_CanPlay = False   ' disallow by default

    If Not Game_InProgress Then Exit Function

    If pl% = 1 Then
        If Hand_CardPlayer1 <> CARD_EMPTY Then Exit Function  ' has already played
        If Hand_PlayerTurn <> 1 Then Exit Function           ' not his turn

        ' this checks whether he is still waiting for cards to be dealt
        If Game.Player1.NumCards < 3 And Game.Deck.NumCards > 0 Then Exit Function
    Else
        If Hand_CardPlayer2 <> CARD_EMPTY Then Exit Function  ' has already played
        If Hand_PlayerTurn = 1 Then Exit Function          ' not his turn

        ' this checks whether he is still waiting for cards to be dealt
        If Game.Player2.NumCards < 3 And Game.Deck.NumCards > 0 Then Exit Function
    End If

    Hand_CanPlay = True

End Function

'
' Clear 'played cards', allowing players to play again
'
Sub Hand_Clear()
    Trace "Hand_Clear"

    Hand_CardPlayer1 = CARD_EMPTY
    Hand_CardPlayer2 = CARD_EMPTY
End Sub

Sub Hand_DealCard(dest As Cardpack)
    Dim x%, y%

    If App_Debug Then Trace "Hand_DealCard"

    ' check if dealing last hand
    If Game.Deck.NumCards > 0 Then
        Game.MoveCard Game.Deck, Game.Deck.NumCards - 1, dest
    Else
        Game.MoveCard Game.Briscola, 0, dest
    End If

    If App_Debug Then Trace "Hand_DealCard: dealt " & CardName$(dest.Card(dest.NumCards - 1))

End Sub

Sub Hand_StashCard(dest As Cardpack)
    If App_Debug Then Trace "Hand_StashCard"

    Game.MoveCard Game.OnTable, Game.OnTable.NumCards - 1, dest
End Sub

Sub Hand_PlayCard(src As Cardpack, idx%)

    If App_Debug Then Trace "Hand_PlayCard"
    Game_Msg "Player plays the " & CardName$(src.Card(idx%))
    Game.MoveCard src, idx%, Game.OnTable
End Sub


Sub Main()
    If App_Debug Then Trace "Main"

    App_Init Game


    AboutForm.Show 1
    Game.Show
    If Not Game_Options() Then End

End Sub

Sub Game_Accept(CmdStr As String, Cancel As Integer)

    Dim r%, s$
    If App_Debug Then Trace "Game_Accept"

    r% = InStr(CmdStr, ",")

    Game_OtherPC = Left$(CmdStr, r% - 1)
    Game_OtherPlayer = Mid$(CmdStr, r% + 1)

    s$ = Game_OtherPlayer & " challenges you from " & Game_OtherPC
    s$ = s$ & Chr$(10) & "Do you accept the challenge?"

    If MsgBox(s$, MB_YESNO + MB_ICONQUESTION) = IDNO Then
        Cancel = True
    Else
        Game_ModeNetwork
        Game.GameTimer.Enabled = True    ' will connect back ASAP.
        Cancel = False              ' by default, cancel = True
    End If

End Sub



'
' Find card that's higher than given card (lowest first).
' same suit or any, depending on pattern
'
' retuns card index
'
Function CardPack_FindHigherThan(cs As Cardpack, pat%) As Integer
    Dim s%, v%, i%, c%

    c% = 0
    s% = CardSuit(pat%)
    v% = CardValue(pat%)

    For i% = v% + 1 To KING
        c% = cs.Find(s% + i%)
        If c% <> CARD_NONE Then Exit For
    Next i%

    CardPack_FindHigherThan = c%

End Function

'
' Find card that's lower than given card (highest first).
' same suit or any, depending on pattern
'
' retuns card index
'
Function CardPack_FindLowerThan(cs As Cardpack, pat%) As Integer
        Dim s%, v%, i%, c%

        c% = 0
        s% = CardSuit(pat%)
        v% = CardValue(pat%)

        For i% = v% - 1 To ACE Step -1
            c% = cs.Find(s% + i%)
            If c% <> CARD_NONE Then Exit For
        Next i%

        CardPack_FindLowerThan = c%

End Function

Function Game_AllowAbort()

    Dim response As Integer
    Dim Msg As String

    response = IDNO
    Game_AllowAbort = True
    If App_Debug Then Trace "Game_AllowAbort"

    If Game_InProgress = True Then
        Msg = "A game is in progress" & Chr$(10)
        Msg = Msg & "Save it before continuing?"
        response = MsgBox(Msg, MB_YESNOCANCEL + MB_ICONQUESTION, App.Title)
    End If

    Select Case response
        Case IDYES
            Game_Save Game_FileName$
        Case IDNO
        Case IDCANCEL
            Game_AllowAbort = False
    End Select
End Function

'
' Game plays for a player if:
' - it's this player's turn
' - autoplay is enabled for this player
' - 3 cards have been given to this player (or it's last hand)
' Will only do one player per run
'
Sub Game_AutoPlay()

    If App_Debug Then Trace "Game_AutoPlay"

    ' up to player one ?
    If Hand_CanPlay(1) And Player1_AutoPlay Then
        Robot_PlayCard Game.Player1
        Exit Sub
    End If

    ' up to player two
    If Hand_CanPlay(2) And Player2_AutoPlay Then
        Robot_PlayCard Game.Player2
        Exit Sub
    End If
End Sub

Function Game_CalcScore(Deck As Cardpack) As Integer
    Dim Score%

    If App_Debug Then Trace "Game_CalcScore"

    ' aces value = 11
    Score% = 11 * Deck.Count(ACE)

    ' 3 value = 10
    Score% = Score% + 10 * Deck.Count(3)

    ' king, queen, jack = 3,2,1
    Score% = Score% + 4 * Deck.Count(KING)
    Score% = Score% + 3 * Deck.Count(QUEEN)
    Score% = Score% + 2 * Deck.Count(JACK)

    Game_CalcScore = Score%

End Function

Sub Game_Clear()
    If App_Debug Then Trace "Game_Clear"

    Game_InProgress = False
    Game.GameTimer.Enabled = False

    Game_FileName$ = Game_NoFileName$

    Player1_Score = 0
    Player2_Score = 0

    Game_ShowScore

End Sub

Function Game_Connect(OtherPC As String, IsReply As Integer) As Integer
    Dim s$

    If App_Debug Then Trace "Game_Connect"

    On Error GoTo net_err

    Game_Connect = False

    'If OtherPC = "" Then Exit Function
    'Debug.Print "----- Connecting -----"

    ' give time to other replay to accept challenge (20s)
    If IsReply Then
        Game.Player2Name.LinkTimeout = 50
    Else
        Game.Player2Name.LinkTimeout = 200
    End If

    ' This is used to get a link on which a challenge is sent
    NDDEConnect Game.Player2Name, OtherPC, App_DDEShare, "Player1Name"


    If Not IsReply Then
        ' if we're connecting (NOT replying to a connection)
        ' send a challenge, with our computer name as a command
        s$ = NetHostName$() & "," & Player1_Name
        Game_NetCommand "C", s$
    End If

    ' these are cross-linked
    NDDEConnect Game.Player1, OtherPC, App_DDEShare, "Player2"
    NDDEConnect Game.Player2, OtherPC, App_DDEShare, "Player1"

    NDDEConnect Game.Stack1, OtherPC, App_DDEShare, "Stack2"
    NDDEConnect Game.Stack2, OtherPC, App_DDEShare, "Stack1"

    NDDEConnect Game.OnTable, OtherPC, App_DDEShare, "OnTable"
    NDDEConnect Game.Deck, OtherPC, App_DDEShare, "Deck"
    NDDEConnect Game.Briscola, OtherPC, App_DDEShare, "Briscola"

    Game_Connect = True
    'Debug.Print "----- Connected OK -----"

    Exit Function

net_err:

    Game_Disconnect
    MsgBox "Failed Connecting to " & OtherPC & Chr$(10) & " (" & Error$ & ")"
    Exit Function

End Function

Sub Game_ConnectBack()
    If App_Debug Then Trace "Game_ConnectBack"

    If Game_Connect(Game_OtherPC, True) Then
        Hand_SetNextPlayer 1
        Game_Start
    Else
        Game_Disconnect
        Game_ModeNormal
    End If

End Sub

'
' Returns # of cards already played matching pattern
' for strategy support.
'
' Simulates memory by peeking into the 2 players
' 'captured cards' stacks
'
Function Game_CountPlayed(c%) As Integer

    If App_Debug Then Trace "Game_CountPlayed"

    Dim n%

    n% = Game.Stack1.Count(c%)
    n% = n% + Game.Stack2.Count(c%)

    Game_CountPlayed = c%

End Function

Sub Game_Disconnect()
    If App_Debug Then Trace "Game_Disconnect"

    Game.Player2Name.LinkMode = 0

    Game.Player1.LinkMode = 0
    Game.Player2.LinkMode = 0

    Game.Stack1.LinkMode = 0
    Game.Stack2.LinkMode = 0

    Game.OnTable.LinkMode = 0
    Game.Deck.LinkMode = 0
    Game.Briscola.LinkMode = 0

End Sub

Sub Game_Finish(fAbort As Integer)
    If App_Debug Then Trace "Game_Finish"

    If Game_InProgress Then

        If fAbort Then
            If Not Game_AllowAbort() Then Exit Sub

            If Game_Mode = MODE_NETWORK Then
                Game_Disconnect
            End If
            ' Game_ModeNormal
        Else
            If Player1_Score > Player2_Score Then
                MsgBox Game_PlayerName(1) & WINS_GAME & Player1_Score & "-" & Player2_Score
            Else
                If Player1_Score < Player2_Score Then
                    MsgBox Game_PlayerName(2) & WINS_GAME & Player2_Score & "-" & Player1_Score
                Else
                    MsgBox GAME_IS_DRAW
                End If
            End If
        End If

        Game.GameTimer.Enabled = False
        Game_InProgress = False

    End If

    Game.ModeStop

End Sub

Sub Game_GiveHint()
    Dim idx%

    If App_Debug Then Trace "Game_GiveHint"

    If Hand_PlayerTurn = 1 Then
        idx% = Robot_ThinkCard(Game.Player1)

        If idx% <> CARD_NONE Then
            Game.Player1.Selected(idx%) = True
            Game.MessageView = "I suggest you play the " & CardName$(Game.Player1.Card(idx%))
        End If
    Else
        Game.MessageView = Game_PlayerName(1) & NOT_YOUR_TURN
    End If

End Sub
Sub Game_Listen()
    Dim r%

    If App_Debug Then Trace "Game_Listen"
    r% = NDDEListen(App_DDEShare, "BRISCOLA", "Table")

End Sub

Sub Game_ModeDemo()
    If App_Debug Then Trace "Game_ModeDemo"

    Player1_Name = "Computer 1"
    Player2_Name = "Computer 2"

    Player1_AutoPlay = True
    Player2_AutoPlay = True

    Game.OptPeek.Checked = 1
    Game.Player2.StackFacing = CARDS_FACING_UP

    Game.Mode = MSG_MODE_DEMO
    Game_Mode = MODE_DEMO

End Sub

Sub Game_ModeNetwork()

    If App_Debug Then Trace "Game_ModeNetwork"

    If App_Debug Then
        Player1_AutoPlay = True
    Else
        Player1_AutoPlay = False
    End If

    Player2_AutoPlay = False

    If App_Debug Then
        Game.OptPeek.Checked = 1
        Game.Player2.StackFacing = CARDS_FACING_UP
        Game.GameTimer.Interval = 100   ' faster than normal
    Else
        Game.OptPeek.Checked = 0
        Game.Player2.StackFacing = CARDS_FACING_DOWN
    End If

    Game_Mode = MODE_NETWORK
    Game.Mode = MSG_MODE_NETWORK

End Sub

Sub Game_ModeNormal()

    If App_Debug Then Trace "Game_ModeNormal"
    Player2_Name = "Computer"

    Player1_AutoPlay = False
    Player2_AutoPlay = True

    Game.OptPeek.Checked = 0
    Game.Player2.StackFacing = CARDS_FACING_DOWN

    Game.Mode = MSG_MODE_NORMAL
    Game_Mode = MODE_NORMAL

End Sub

Sub Game_Msg(Msg$)
    Game.MessageView.Caption = Msg$
    Game.MessageView.Refresh
End Sub

'
' Manda comando al partner, con parametri
'
Sub Game_NetCommand(c$, p$)
    If App_Debug Then Trace "Game_NetCommand"

    Game.Player2Name.LinkExecute c$ & p$
End Sub

Sub Game_New()

    If App_Debug Then Trace "Game_New"
    If Game_AllowAbort() = True Then

        Game_Clear
        Game_Start
        Table_Clear
        Hand_DealFirst

    End If

    If Game_Mode = MODE_NETWORK Then Game_NetCommand "R", ""

End Sub

' Switch sides if 1st card was played
Sub Hand_SwitchPlayer()

    If App_Debug Then Trace "Hand_SwitchPlayer"

    If Game.OnTable.NumCards = 1 Then

        ' make a note of who played, so we know he can't play
        ' until next hand has been dealt

        If Hand_PlayerTurn = 1 Then
            Hand_CardPlayer1 = Game.OnTable.Card(0)
        Else
            Hand_CardPlayer2 = Game.OnTable.Card(0)
        End If

        Hand_SetNextPlayer (Hand_PlayerTurn + 1)
    End If
End Sub

Sub Hand_SetNextPlayer(pl%)
    If App_Debug Then Trace "Hand_SetNextPlayer: " & (pl% Mod 2)

    Hand_PlayerTurn = pl% Mod 2
    Game.MessageView = Game_PlayerName(Hand_PlayerTurn) & MUST_PLAY

End Sub

Sub Game_OpenAsBin(fname As String)
    If App_Debug Then Trace "Game_OpenAsBin"

    Dim s$

    On Error GoTo open_error

    Open fname For Random As #1

    On Error GoTo open_done

    Get #1, , Hand_Number
    Get #1, , Hand_CardPlayer1
    Get #1, , Hand_CardPlayer2
    Get #1, , Hand_PlayerTurn
    Get #1, , Hand_Winner
    Get #1, , Game_BriscolaSuit

    Get #1, , Player1_Score
    Get #1, , Player1_AutoPlay
    Get #1, , Player1_Name

    Get #1, , Player2_AutoPlay
    Get #1, , Player2_Score
    Get #1, , Player2_Name

    Get #1, , s$
    Game.Player1 = s$
    Get #1, , s$
    Game.Player2 = s$
    Get #1, , s$
    Game.Stack1 = s$
    Get #1, , s$
    Game.Stack2 = s$
    Get #1, , s$
    Game.Briscola = s$
    Get #1, , s$
    Game.OnTable = s$
    Get #1, , s$
    Game.Deck = s$



open_done:

    Close #1
    Exit Sub

open_error:
    ReportError "Can't open File" & Chr$(10) & "'" & fname & "'"
    Exit Sub
End Sub

Function Game_Options() As Integer
    Dim New_mode As Integer

    If App_Debug Then Trace "Game_Options"
    Options.Show 1

    If Options.Tag = "OK" Then
        Player1_Name = Options.NameBox

        If Options.OptVsNetwork.Value Then
            New_mode = MODE_NETWORK
            Else
                If Options.OptDemo.Value Then
                    New_mode = MODE_DEMO
                Else
                    New_mode = MODE_NORMAL
            End If
        End If

        ' record player name, just in case.
        Profile_WriteString SEC_GLOBAL, "PlayerName", Player1_Name

        ' if different, change mode and start new game

        If New_mode <> Game_Mode Then
            Select Case New_mode
                Case MODE_NETWORK

                    If Game_Connect(NetBrowseHost$(), False) Then
                        Game_ModeNetwork
                        Hand_SetNextPlayer 2  ' let other player start
                    End If

                Case MODE_DEMO
                    Game_ModeDemo

                Case Else
                    Game_ModeNormal
            End Select

        End If

        Game_Options = True
        Game_Finish True
        Game_New
    Else
        Game_Options = False
    End If

End Function

Sub Game_Pause(paused%)
    If App_Debug Then Trace "Game_Pause"

    If paused% Then
        Game.GameTimer.Enabled = False
        Game_Msg "Paused"
        Game.ModePause
    Else
        Game.GameTimer.Enabled = True
        Game_Msg "Resumed"
        Game.ModeRun
    End If

End Sub

'
' Implements simple player game strategy
' Retuns index of next card this player should play
'
Function Robot_ThinkCard(pl As Cardpack) As Integer

    Dim cidx%, t_val%, t_suit%, i%

    If App_Debug Then Trace "Robot_ThinkCard"
    cidx% = CARD_NONE

    ' must play against table
    If Game.OnTable.NumCards = 1 Then
        t_val% = Game.OnTable.Value(0)
        t_suit% = Game.OnTable.Suit(0)

        ' no points on the table. Take it only if
        ' we can make some points (jack, queen)
        If t_val% = 2 Or (t_val% > 3 And t_val% < JACK) Then

            cidx% = pl.Find(JACK + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

            cidx% = pl.Find(QUEEN + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

        End If

        ' small points on the table. Try to take it.
        If t_val% >= JACK And t_val% < KING Then

            cidx% = CardPack_FindHigherThan(pl, t_val% + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

            ' may also want to use 3 or ACE if deck is running low
            If Game.Deck.NumCards < 20 Then
                cidx% = pl.Find(3 + t_suit%)
                If cidx% <> CARD_NONE Then GoTo Chosen

                cidx% = pl.Find(ACE + t_suit%)
                If cidx% <> CARD_NONE Then GoTo Chosen
            End If
        End If

        ' always take king, try with 3 or ace
        If t_val% = KING Then
            cidx% = pl.Find(3 + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

            cidx% = pl.Find(ACE + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen
        End If

        ' always take 3, can only be taken by ace
        If t_val% = 3 Then
            cidx% = pl.Find(ACE + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen
        End If


        ' we want that 3 or ace, but can't beat it with the same suit
        ' try taking it with a briscola, lowest first (3 and ace last)
        If t_val% = 3 Or t_val% = ACE Then
            cidx% = pl.Find(2 + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

            cidx% = CardPack_FindHigherThan(pl, 3 + Game_BriscolaSuit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

            cidx% = pl.Find(3 + Game_BriscolaSuit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

            cidx% = pl.Find(ACE + Game_BriscolaSuit%)
            If cidx% <> CARD_NONE Then GoTo Chosen

        End If

        ' card on table is nil points, but maybe we can make points
        ' taking it with a higher card of ours (not a briscola)

        If t_suit% <> Game_BriscolaSuit Then
            ' use ace only if 3 is gone
            If Game_CountPlayed(3 + t_suit%) > 0 Then
                cidx% = pl.Find(ACE + t_suit%)
                If cidx% <> CARD_NONE Then GoTo Chosen
            End If

            ' use 3 only if king is gone
            If Game_CountPlayed(KING + t_suit%) > 0 Then
                cidx% = pl.Find(3 + t_suit%)
                If cidx% <> CARD_NONE Then GoTo Chosen
            End If

            ' use king only if queen is gone
            If Game_CountPlayed(QUEEN + t_suit%) > 0 Then
                cidx% = pl.Find(KING + t_suit%)
                If cidx% <> CARD_NONE Then GoTo Chosen
            End If

            ' use queen only if jack is gone
            If Game_CountPlayed(JACK + t_suit%) > 0 Then
                cidx% = pl.Find(QUEEN + t_suit%)
                If cidx% <> CARD_NONE Then GoTo Chosen
            End If

            cidx% = pl.Find(JACK + t_suit%)
            If cidx% <> CARD_NONE Then GoTo Chosen
        End If

    End If

    ' if we get here, we are either playing 1st
    ' or we're not interested in the card that's on the table

    ' find lowest card in hand that's not a briscola
    For i% = HEARTS To SPADES Step ONE_SUIT

        If i% <> Game_BriscolaSuit% Then
            ' see if we have a 2
            cidx% = pl.Find(i% + 2)
            If cidx% <> CARD_NONE Then GoTo Chosen

            ' or any lowest card that's not points
            cidx% = CardPack_FindHigherThan(pl, i% + 3)
            If cidx% <> CARD_NONE Then
                If pl.Value(cidx%) < JACK Then GoTo Chosen
            End If
        End If
    Next i%


    ' Next, see if we can play a briscola that's not points
    ' see if we have a 2
    cidx% = pl.Find(Game_BriscolaSuit% + 2)
    If cidx% <> CARD_NONE Then GoTo Chosen

    ' or any lowest briscola that's also not points
    cidx% = CardPack_FindHigherThan(pl, Game_BriscolaSuit% + 3)
    If cidx% <> CARD_NONE Then
        If pl.Value(cidx%) < JACK Then GoTo Chosen
    End If


    ' Next, see if we have to give in small points (not briscola)
    For i% = HEARTS To SPADES Step ONE_SUIT

        If i% <> Game_BriscolaSuit% Then
        ' look for Jack, Queen, King
            cidx% = CardPack_FindHigherThan(pl, i% + 10)
            If cidx% <> CARD_NONE Then GoTo Chosen
        End If
    Next i%


    ' Next, see if we have to play a briscola that's small points
    ' look for Jack, Queen, King
    cidx% = CardPack_FindHigherThan(pl, Game_BriscolaSuit% + 10)
    If cidx% <> CARD_NONE Then GoTo Chosen


    ' Next, see if we have to play a briscola that's BIG points
    cidx% = pl.Find(Game_BriscolaSuit% + 3)
    If cidx% <> CARD_NONE Then GoTo Chosen

    cidx% = pl.Find(Game_BriscolaSuit% + ACE)
    If cidx% <> CARD_NONE Then GoTo Chosen


    ' Last, see if we have to give in BIG points
    For i% = HEARTS To SPADES Step ONE_SUIT

        If i% <> Game_BriscolaSuit% Then
            cidx% = pl.Find(i% + 3)
            If cidx% <> CARD_NONE Then GoTo Chosen

            cidx% = pl.Find(i% + ACE)
            If cidx% <> CARD_NONE Then GoTo Chosen
        End If
    Next i%


    ' We should never get here undecided, however...
    cidx% = 0  ' 1st card


Chosen:
    Robot_ThinkCard = cidx%

End Function

Function Game_PlayerName(pl%) As String

    If pl% = 1 Then
        Game_PlayerName = Player1_Name
    Else
        Game_PlayerName = Player2_Name
    End If

End Function

Sub Game_SaveAsBin(fname As String)

    Dim s$
    If App_Debug Then Trace "Game_SaveAsBin"
    On Error GoTo save_error

    Open fname For Random As #1

    On Error GoTo write_error

    Put #1, , Hand_Number
    Put #1, , Hand_CardPlayer1
    Put #1, , Hand_CardPlayer2
    Put #1, , Hand_PlayerTurn
    Put #1, , Hand_Winner

    Put #1, , Game_BriscolaSuit

    Put #1, , Player1_Score
    Put #1, , Player1_AutoPlay
    Put #1, , Player1_Name

    Put #1, , Player2_AutoPlay
    Put #1, , Player2_Score
    Put #1, , Player2_Name

    s$ = Game.Player1
    Put #1, , s$
    s$ = Game.Player2
    Put #1, , s$
    s$ = Game.Stack1
    Put #1, , s$
    s$ = Game.Stack2
    Put #1, , s$
    s$ = Game.Briscola
    Put #1, , s$
    s$ = Game.OnTable
    Put #1, , s$
    s$ = Game.Deck
    Put #1, , s$

    Game_FileName = fname
    Form_SetTitle Game

write_error:
    Close #1


save_error:
    Exit Sub
End Sub

Sub Game_SetDefaults()
    If App_Debug Then Trace "Game_SetDefaults"
    Player2_AutoPlay = True
    Game.Mode = MSG_MODE_NORMAL
    Game.MessageView = "Select [New] to start"
End Sub

Sub Game_ShowScore()
    If App_Debug Then Trace "Game_ShowScore"

    Player1_Score% = Game_CalcScore(Game.Stack1)
    Player2_Score% = Game_CalcScore(Game.Stack2)

    Game.Score1 = Player1_Score%
    Game.Score2 = Player2_Score%

    Game.Score = "Score: " & Player1_Score% & "-" & Player2_Score%

End Sub

Sub Game_Start()
    If App_Debug Then Trace "Game_Start"
    Game_InProgress = True
    Hand_Number = 1
    TraceClear

    Game.ModeRun
    Game.GameTimer.Enabled = True
End Sub


'
Sub Hand_CheckWinner()

    Dim Suit1%, Suit2%, Val1%, Val2%

    If App_Debug Then Trace "Hand_CheckWinner"
    Game_Msg "Checking Hand..."

    ' retrieve cards that were played
    If Hand_PlayerTurn = 1 Then
        Hand_CardPlayer1 = Game.OnTable.Card(1)
        Hand_CardPlayer2 = Game.OnTable.Card(0)
    Else
        Hand_CardPlayer1 = Game.OnTable.Card(0)
        Hand_CardPlayer2 = Game.OnTable.Card(1)
    End If


    Suit1% = CardSuit(Hand_CardPlayer1)
    Suit2% = CardSuit(Hand_CardPlayer2)
    Val1% = CardValue(Hand_CardPlayer1)
    Val2% = CardValue(Hand_CardPlayer2)


    ' both have same suit?
    If Suit2% = Suit1% Then

        ' if so, higher card wins
        ' must first shift 3 and ace to higher values
        If Val1% = 3 Then Val1% = 14
        If Val2% = 3 Then Val2% = 14

        If Val1% = 1 Then Val1% = 15
        If Val2% = 1 Then Val2% = 15

        If Val1% > Val2% Then
            Hand_Winner = 1
        Else
            Hand_Winner = 2
        End If

    ' different suits
    Else

        ' check vs. briscola
        If Suit1% = Game_BriscolaSuit% Then
            Hand_Winner = 1

        ' player 1 doesn't have briscola
        Else

            ' if p2 has, he wins
            If Suit2% = Game_BriscolaSuit% Then
                Hand_Winner = 2

            ' otherwise, player who put card down 1st wins
            Else
                ' Hand_PlayerTurn indicates last player, so other was 1st
                If Hand_PlayerTurn = 1 Then
                    Hand_Winner = 2
                Else
                    Hand_Winner = 1
                End If
            End If

        End If
    End If

    Game_Msg Game_PlayerName(Hand_Winner) & WINS_HAND

End Sub


Sub Hand_Deal()

    If App_Debug Then Trace "Hand_Deal"

    If Game_IsDealer() Then

        Table_Disable "Dealing..."

        Game.Player1.Action = CARDS_ACTION_PACK
        Game.Player2.Action = CARDS_ACTION_PACK

        ' pick cards from deck
        If Game.Deck.NumCards > 0 Then

            ' give cards according to last hand results
            If Hand_Winner% = 1 Then
                Hand_DealCard Game.Player1
                Hand_DealCard Game.Player2
            Else
                Hand_DealCard Game.Player2
                Hand_DealCard Game.Player1
            End If

        End If
        Table_Enable

    End If
End Sub
'
'
Sub Hand_DealFirst()

    If Game.Deck.NumCards = 0 Then Exit Sub

    If App_Debug Then Trace "Hand_DealFirst:"

    If Game_IsDealer() Then
        Table_Disable "Dealing..."

        Hand_SwitchPlayer

        ' player 2 deals, player 1 gets cards first

        If Hand_PlayerTurn = 1 Then
            Hand_DealCard Game.Player2
            Hand_DealCard Game.Player1
            Hand_DealCard Game.Player2
            Hand_DealCard Game.Player1
            Hand_DealCard Game.Player2
            Hand_DealCard Game.Player1
        Else
            Hand_DealCard Game.Player1
            Hand_DealCard Game.Player2
            Hand_DealCard Game.Player1
            Hand_DealCard Game.Player2
            Hand_DealCard Game.Player1
            Hand_DealCard Game.Player2
        End If

        Game.Briscola.TopCard = Game.Deck.TopCard

        Table_Enable
    End If

End Sub

Sub Hand_Next()

    If App_Debug Then Trace "Hand_Next"
    Hand_Stash Hand_Winner    ' give cards to winner
    Game_ShowScore            '

    ' Game is finished when players have no more cards in hand
    ' (deck was already emptied a couple of hands ago)

    ' note: we use Count() and not NumCards
    ' because cards may be unpacked (yet).
    If Game.Player1.Count(0) = 0 Then       ' is it over?
        Game_Finish False
    Else
        Hand_Deal
        Hand_SetNextPlayer Hand_Winner      ' Decide next player
        Hand_Number = Hand_Number + 1       ' Count hands

    End If

                                            ' GameTimer Will no longer call us

    If App_Debug Then Trace "Hand_Next: done. Next player is " & Hand_PlayerTurn

End Sub

Sub Hand_Stash(PrevWinner%)

    If App_Debug Then Trace "Hand_Stash"

    If Game_IsDealer() Then
        If PrevWinner% = 1 Then
            Hand_StashCard Game.Stack1
            Hand_StashCard Game.Stack1
        Else
            Hand_StashCard Game.Stack2
            Hand_StashCard Game.Stack2
        End If
    End If

End Sub

Sub Options_Read(f As Form)
    Dim WorkDir$

    On Error Resume Next

    WorkDir$ = Profile_ReadString$(SEC_GLOBAL, KEY_WORKDIR, "")
    If WorkDir <> "" Then ChDir WorkDir

    Player1_Name = Profile_ReadString$(SEC_GLOBAL, "PlayerName", "")

    RecentFile_Read f

    f.OptToolBar.Checked = Profile_ReadBool("Options", "ToolBar", True)
    f.OptStatusBar.Checked = Profile_ReadBool("Options", "StatusBar", True)
    f.OptSound.Checked = Profile_ReadBool("Options", "Sound", True)
    f.OptAnimate.Checked = Profile_ReadBool("Options", "Animation", False)


    f.ToolBar.Visible = f.OptToolBar.Checked
    f.StatusLine.Visible = f.OptStatusBar.Checked

End Sub

Sub Options_Write(f As Form)

    RecentFile_Write f

    Profile_WriteString SEC_GLOBAL, KEY_WORKDIR, CurDir$
    Profile_WriteString SEC_GLOBAL, "PlayerName", Player1_Name

    Profile_WriteBool "Options", "ToolBar", (f.OptToolBar.Checked)
    Profile_WriteBool "Options", "StatusBar", (f.OptStatusBar.Checked)
    Profile_WriteBool "Options", "Sound", (f.OptSound.Checked)
    Profile_WriteBool "Options", "Animation", (f.OptAnimate.Checked)

End Sub

Sub Robot_PlayCard(pl As Cardpack)
    Dim idx%

    If App_Debug Then Trace "Robot_PlayCard"
    Table_Disable "Thinking..."
    idx% = Robot_ThinkCard(pl)

    If idx% <> CARD_NONE Then

        ' animate card before removing
        pl.Selected(idx%) = True
        Sleep 0.5

        ' play that card
        Hand_PlayCard pl, idx%

    End If

    Table_Enable

End Sub

Sub Sleep(s As Single)

    Dim start

    start = Timer
    Do
        'DoEvents
    Loop Until Timer > start + s

End Sub

Sub Table_Clear()

    Table_Disable "Preparing table..."

    Game.Stack1.NumCards = 0
    Game.Stack2.NumCards = 0
    Game.Player1.NumCards = 0
    Game.Player2.NumCards = 0
    Game.Deck.NumCards = 40
    Game.OnTable.NumCards = 0
    Game.Briscola.NumCards = 0

    Game.Deck.Shuffle
    Game_ShowScore
    Table_Enable

End Sub

Sub Table_Disable(Msg$)

    ' Avoid nesting
    If Game.Enabled = True Then
        Game_Msg Msg$
        Screen.MousePointer = HOURGLASS
        Game.Enabled = False
    End If

End Sub

Sub Table_Enable()

    ' Avoid nesting
    If Not Game.Enabled Then
        Game.Enabled = True
        'Game_Msg "Ready"
        Screen.MousePointer = Default
    End If
End Sub

Sub Trace(s$)

    If App_Debug Then
        TraceWin.LogBox.AddItem s$
        If TraceWin.LogBox.ListCount > 100 Then TraceWin.LogBox.RemoveItem 0
        TraceWin.LogBox.TopIndex = TraceWin.LogBox.ListCount - 1
        Debug.Print s$
    End If

End Sub

Sub TraceClear()
    TraceWin.LogBox.Clear
End Sub

Sub TraceMode(Mode%)
    If Mode% Then
        App_Debug = True
        TraceWin.Show
    Else
        App_Debug = False
        TraceWin.Hide
    End If
End Sub